;;   This file is part of scheme-GNUnet, a partial Scheme port of GNUnet.
;;   Copyright (C) 2005--207 GNUnet e.V.
;;   Copyright (C) 2020 Maxime Devos <maxime.devos@student.kuleuven.be>
;;
;;   GNUnet is free software: you can redistribute it and/or modify it
;;   under the terms of the GNU Affero General Public License as published
;;   by the Free Software Foundation, either version 3 of the License,
;;   or (at your option) any later version.
;;
;;   GNUnet is distributed in the hope that it will be useful, but
;;   WITHOUT ANY WARRANTY; without even the implied warranty of
;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;   Affero General Public License for more details.
;;
;;   You should have received a copy of the GNU Affero General Public License
;;   along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;;   SPDX-License-Identifier: AGPL-3.0-or-later
;;
;;   As a special exception to the GNU Affero General Public License,
;;   the file may be relicensed under any license used for
;;   most source code of GNUnet 0.13.1, or later versions, as published by
;;   GNUnet e.V.

;; Extracted from src/util/strings.c by Nils Durner and Christian Grothoff.

;; Deviations from upstream:
;;   * Alternative characters aren't recognised.
;;     (The alternative encodings aren't generated by GNUnet anyway)
;;     TODO: perhaps reject alternate encodings (e.g. "00" and "01" both
;;     decode to 0 currently)

(library (gnu gnunet data-string (1 1))
  (export data->string string->data)
  (import (rnrs base)
          (rnrs control)
	  (rnrs bytevectors)
	  (rnrs arithmetic bitwise))

  (define charset "0123456789ABCDEFGHJKMNPQRSTVWXYZ")

  (define data->string
    (case-lambda
      "Convert binary data to ASCII encoding using Crockford Base32 encoding.

@var{bv}: data to encode
@var{offset}: start position of data to encode
@var{size}: length of data to encode, in octets"
      ((bv) (data->string bv 0 (bytevector-length bv)))
      ((bv offset size)
       (let loop ((vbit 0) (rpos offset) (bits 0) (accumulated '()))
         (if (or (< (- rpos offset) size) (> vbit 0))
             (begin
               (when (and (< (- rpos offset) size) (< vbit 5))
		 (set! bits (bitwise-ior (bitwise-arithmetic-shift-left bits 8)
					 (bytevector-u8-ref bv rpos)))
		 (set! rpos (+ 1 rpos))
		 (set! vbit (+ vbit 8)))
               (when (< vbit 5)
		 (set! bits (bitwise-arithmetic-shift-left bits (- 5 vbit)))
		 (assert (= vbit (mod (* 8 size) 5)))
		 (set! vbit 5))
               (loop (- vbit 5) rpos bits
		     (cons (string-ref charset
				       (bitwise-and
					(bitwise-arithmetic-shift-right
					 bits (- vbit 5)) 31))
			   accumulated)))
             (begin (assert (= 0 vbit))
                    (apply string (reverse accumulated))))))))

  (define (get-value ch)
    "Get the decoded value corresponding to a character according to Crockford
Base32 encoding."
    (cond ((and (char<=? #\0 ch) (char<=? ch #\9))
	   (- (char->integer ch) (char->integer #\0)))
	  ((and (char<=? #\A ch) (char<=? ch #\H))
	   (- (char->integer ch) (char->integer #\A) -10))
	  ((and (char<=? #\J ch) (char<=? ch #\K))
	   (- (char->integer ch) (char->integer #\J) -18))
	  ((and (char<=? #\M ch) (char<=? ch #\N))
	   (- (char->integer ch) (char->integer #\M) -20))
	  ((and (char<=? #\P ch) (char<=? ch #\T))
	   (- (char->integer ch) (char->integer #\P) -22))
	  ((and (char<=? #\V ch) (char<=? ch #\Z))
	   (- (char->integer ch) (char->integer #\V) -27))
	  (else #f)))

  (define string->data
    (lambda (enc out-size)
      "Convert Crockford Base32hex encoding back to data

Return the data as a bytevector on success, or return #f
if result has the wrong encoding.
@var{out-size} must exactly match the size of the data before it was encoded.

@var{enc} the encoding
@var{out-size} size of output buffer"
      (let ((rpos (string-length enc))
	    (bits #f)
	    (vbit #f)
	    (ret #f)
	    (shift #f)
	    (encoded-len (* 8 out-size))
	    (uout (make-bytevector out-size)))
	(if (= 0 (string-length enc))
	    (if (= 0 out-size)
		#vu8()
		#f)
	    (begin
	      (if (< 0 (mod encoded-len 5))
		  (begin ; padding!
		    (set! vbit (mod encoded-len 5))
		    (set! shift (- 5 vbit))
		    (set! rpos (- rpos 1))
		    (set! ret (get-value (string-ref enc rpos)))
		    (set! bits (bitwise-arithmetic-shift-right ret shift)))
		  (begin
		    (set! vbit 5)
		    (set! shift 0)
		    (set! rpos (- rpos 1))
		    (set! ret (get-value (string-ref enc rpos)))
		    (set! bits ret)))
	      (cond ((not (= (/ (+ encoded-len shift) 5)
			     (string-length enc)))
		     #f)
		    ((not ret)
		     #f)
		    (else
		     (let loop ((wpos out-size))
		       (if (> wpos 0)
			   (begin
			     (assert (not (= 0 rpos)))
			     (set! rpos (- rpos 1))
			     (set! ret (get-value (string-ref enc rpos)))
			     (set! bits (bitwise-ior
					 (bitwise-arithmetic-shift-left
					  ret vbit)
					 bits))
			     (and ret
				  (begin
				    (set! vbit (+ vbit 5))
				    (when (>= vbit 8)
				      (set! wpos (- wpos 1))
				      (bytevector-u8-set! uout wpos
							  (bitwise-and bits
								       255))
				      (set! bits
					(bitwise-arithmetic-shift-right bits 8))
				      (set! vbit (- vbit 8)))
				    (loop wpos))))
			   (if (and (= 0 rpos) (= 0 vbit))
			       uout
			       #f)))))))))))
